home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.04 Apr 88 / forth sources / Pop up menus < prev    next >
Encoding:
Text File  |  1988-03-07  |  987 b   |  58 lines  |  [TEXT/EDIT]
  1. \ FUNCTION PopUpMenuSelect 
  2. \     (menu: MenuHandle; top, left, popUpItem: INTEGER): LONGINT;
  3. \     INLINE    $A80B;
  4.  
  5. \ popup menu interface from Forth
  6. \ example J. Langowski Jan 1988
  7.  
  8. code popup ( hMenu top left item# | menuID item  -- )
  9.     exg    d4,a7
  10.     clr.l    -(a7)
  11.     move.l    12(a6),-(a7)    \ handle
  12.     move.w    10(a6),-(a7)    \ top
  13.     move.w     6(a6),-(a7)    \ left
  14.     move.w    2(a6),-(a7)    \ item
  15.     adda.l    #16,A6
  16.     _popupmenuselect
  17.     clr.l    d0
  18.     clr.l    d1
  19.     move.w    (a7)+,d0
  20.     move.w    (a7)+,d1
  21.     exg    d4,a7
  22.     move.l    d0,-(a6)
  23.     move.l    d1,-(a6)
  24.     rts
  25. end-code
  26.  
  27. 108 user taskmenubar
  28. 152 user content-hook
  29.  
  30. NEW.MENU myMenu
  31. " TestMenu" myMenu TITLE
  32. -1 150 myMenu BOUNDS \ invisible menu
  33. " Item 1;Item 2;Item 3" myMenu ITEMS
  34.  
  35. taskmenubar @ mymenu add
  36. call drawmenubar
  37.  
  38. : beep 
  39.     ?dup if 
  40.         0 do 5 call sysbeep loop 
  41.     then
  42. ;
  43.  
  44. : content-handler { | pt -- }
  45.     @mouse -> pt
  46.     ^ pt call localtoglobal
  47.     mymenu @
  48.     pt unpack
  49.     1
  50.         popup
  51.     beep drop
  52.     run-content
  53. ;
  54.  
  55. : dopop ['] content-handler content-hook ! ;
  56. : nopop ['] run-content content-hook ! ;
  57.  
  58.